home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / gs24src.zip / PCHARSTR.PS < prev    next >
Text File  |  1992-02-23  |  3KB  |  96 lines
  1. %    Copyright (C) 1990, 1992 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % Print the CharStrings and Subrs (if present) from a Type 1 font,
  21. % in symbolic form.
  22.  
  23. 32 256 add array dup /csdict exch def
  24. 0 [
  25. % base commands
  26.   null (hstem) null (vstem) (vmoveto) (rlineto) (hlineto) (vlineto)
  27.   (rrcurveto) (closepath) (callsubr) (return) null (hsbw) (endchar) null
  28.   null null null null null (rmoveto) (hmoveto) null
  29.   null null null null null null (vhcurveto) (hvcurveto)
  30. % escape commands
  31.   (dotsection) (vstem3) (hstem3) null null null (seac) (sbw)
  32.   null null null null (div) null null null
  33.   (callothersubr) (pop) null null null null null null
  34.   null null null null null null null null
  35.   null (setcurrentpoint)
  36. ] putinterval
  37.  
  38. /printcs
  39.  { dup type /stringtype eq
  40.     { printcs1 (\n) print }
  41.     { ( ) print == }
  42.    ifelse
  43.  } bind def
  44. /printcs1
  45.  { 4330 exch dup length string type1decrypt exch pop
  46.    dup /s exch def length /n exch def
  47.    /lenIV where { pop lenIV } { 4 } ifelse
  48.    1 sub
  49.     { 1 add dup n ge { exit } if
  50.       ( ) print dup s exch get
  51.       dup 31 le
  52.        { dup 12 eq { pop 1 add dup s exch get 32 add } if
  53.          dup csdict exch get dup null eq
  54.       { pop =only (?) print }
  55.       { print pop }
  56.      ifelse
  57.        }
  58.        { dup 247 lt
  59.              { 139 sub }
  60.       { dup 255 eq
  61.          { pop 0 4
  62.             { exch 1 add exch
  63.           8 bitshift s 2 index get add
  64.         } repeat
  65.          }
  66.          { 247 sub
  67.             { {108 add} {364 add} {620 add} {876 add}
  68.           {108 add neg} {364 add neg} {620 add neg} {876 add neg}
  69.         } exch get
  70.            exch 1 add exch s 2 index get exch exec
  71.          }
  72.         ifelse
  73.       }
  74.      ifelse =only
  75.        }
  76.       ifelse
  77.     } loop
  78.    pop
  79.  } bind def
  80.  
  81. /printfont
  82.  { currentfont begin Private begin 10 dict begin
  83.    CharStrings { exch ==only printcs } forall
  84.    Subrs where
  85.     { pop    % the dictionary
  86.       0 1 Subrs length 1 sub
  87.        { dup =only
  88.          Subrs exch get printcs
  89.        } for
  90.     } if
  91.    end end end
  92.  } bind def
  93.  
  94. % /Times-Roman findfont setfont
  95. % printfont
  96.